module Interlude (

  rapp, delIx, allEq, zipKeep, (!:), map', minBy, maxBy, bool,
  Hand(..), hand, fact, church, cacheEnum, minmax, findRepl,
  writeStdIO, justParse, tellLn, pluralSfx,

  module Control.Arrow,
  module Control.Applicative,
  module Control.Monad,
  module Control.Monad.State.Lazy,
  module Control.Monad.Trans,
  module Control.Monad.Writer,
  module Control.Parallel,

  module Data.Char,
  module Data.Function,
  module Data.List,
  module Data.Maybe,
  module Data.Ratio,

  module Numeric,

  module System.IO,
  module System.IO.Unsafe,
  module System.Random,

  module Test.QuickCheck,

  module Text.Parsec.String,
  module Text.Parsec.Prim,
  module Text.Printf

) where

import Control.Applicative (liftA2, liftA3, pure, (<$>), (<$), (<**>), Alternative(..), Applicative(..))
import Control.Arrow (first, second)
import Control.Monad ((>=>), liftM, liftM2, when, MonadPlus, mzero, mplus, msum, join)
import Control.Monad.State.Lazy (evalStateT)
import Control.Monad.Trans (MonadIO, liftIO)
import Control.Monad.Writer (Writer, tell, runWriter)
import Control.Parallel (par, pseq)

import Data.Char (toLower, toUpper)
import Data.Function (on)
import Data.List (elemIndex, find, foldl1', intersperse, nub, splitAt, transpose)
import Data.Maybe (isNothing, isJust, catMaybes, fromJust)
import Data.Ratio ((%), Ratio, numerator, denominator)

import Numeric (showFFloat)

import System.IO (hFlush,hClose,stdout)
import System.IO.Unsafe (unsafePerformIO)
import System.Random (Random(..))

import Test.QuickCheck (Arbitrary(..))

import Text.Parsec.String (Parser)
import Text.Parsec.Prim (parse)
import Text.Printf (printf)

import qualified Data.List as List
import qualified Data.Foldable as Foldable

-- | Reverse append: @x ``rapp`` y = reverse x ++ y@
rapp :: [a] -> [a] -> [a]
rapp = flip $ foldl $ flip (:)

-- | Remove the nth element of a list
delIx :: Int -> [a] -> [a]
delIx = r id
  where r cont 0 (_:xs) = cont xs
        r cont k (x:xs) = r (cont . (x:)) (k-1) xs
        r _  _ []       = error "Interlude.delIx: index too large"

-- | Are all elements in the list equal? If yes, return the (first)
-- element.
allEq :: Eq a => [a] -> Maybe a
allEq (x:xs) = if all (x==) xs then Just x else Nothing

-- | A version of zip that keeps remaining elements.
zipKeep :: (a -> a -> a) -> [a] -> [a] -> [a]
zipKeep f (x0:x') (y0:y') = f x0 y0 !: zipKeep f x' y'
zipKeep _ [] y = y
zipKeep _ x [] = x

-- | A strict version of map
map' :: (a -> b) -> [a] -> [b]
map' f = foldr ((!:) . f) []

-- | List constructor, strict in both arguments
(!:) :: a -> [a] -> [a]
x !: y = x `seq` y `seq` x : y

infixr 5 !:

minBy :: Ord b => (a -> b) -> [a] -> a
minBy f = fst . head . List.sortBy (compare `on` snd) . map (\x -> (x, f x))

maxBy :: Ord b => (a -> b) -> [a] -> a
maxBy f = fst . last . List.sortBy (compare `on` snd) . map (\x -> (x, f x))

-- | An elimination scheme for Bool.
bool :: a -> a -> Bool -> a
bool t f b = if b then t else f

-- | The factorial function. This implementation is memoized.
fact :: Int -> Integer
fact = (!!) (let s f k = f : s (k*f) (k+1) in s 1 1)

data Hand = L | R deriving (Eq,Show,Enum)

hand :: a -> a -> Hand -> a
hand l _ L = l
hand _ r R = r

-- | Church numerals
church :: Num t => t -> (a -> a) -> a -> a
church 0 _ = id
church k f = church (k-1) f . f

-- | Caching for functions with countable domain
cacheEnum :: Enum a => (a -> b) -> a -> b
cacheEnum f = let cache = map (f . toEnum) [0..] in \x -> cache !! fromEnum x

-- | Finding the minimum and maximum of a list simultaneously
minmax :: (Foldable.Foldable t, Ord a) => t a -> (a, a)
minmax (Foldable.toList -> x0:xs) =
  foldr (\x mm (a,b) -> mm (if x < a then (x,b) else
                            if b < x then (a,x) else (a,b))) id xs (x0,x0)

-- | Find an element in a list and return it along with a replacement function
findRepl :: (a -> Bool) -> [a] -> Maybe (a, a -> [a])
findRepl p (break p -> (_,[]))      = Nothing
findRepl p (break p -> (xs1,x:xs2)) = Just (x, \x' -> xs1 ++ x' : xs2)

-- | Connect a Writer to stdout. Flush after every line.
writeStdIO :: Writer String a -> IO a
writeStdIO w = mapM_ (\l -> putStrLn l >> hFlush stdout) (lines s) >> return x
  where (x,s) = runWriter w

-- | Parse and raise an error on failure.
justParse :: Parser a -> String -> a
justParse p = either (error . show) id . parse p ""

-- | Version of 'tell' with built-in newline.
tellLn  :: String -> Writer String ()
tellLn = tell . (++"\n")

-- | Plural suffixes for values /= 1.
pluralSfx :: Num a => a -> String -> String -> String
pluralSfx i word sfx = show i ++ " " ++ word ++ (if i == 1 then "" else sfx)

instance Random Rational where
  random (random -> (a,random -> (b,g))) = (a%b,g)
  randomR (destRatio -> (a1,a2), destRatio -> (b1,b2)) (randomR (a1*b2, b1*a2) -> (c,g)) = (c % (a2*b2),g)

destRatio :: Integral a => Ratio a -> (a,a)
destRatio x = (numerator x, denominator x)